home *** CD-ROM | disk | FTP | other *** search
- # -*- perl -*-
- # Defoma configuration script for fontconfig
- # Copyright © 2003 Angus Lees <gus@debian.org>
- # This file is hereby placed into the public domain.
-
- @ACCEPT_CATEGORIES = qw(type1 truetype cid);
- # .. and any other categories supported by freetype
-
- package fontconfig;
-
- use Debian::Defoma::Common;
- use Debian::Defoma::Id;
- use Debian::Defoma::Subst;
-
- use strict;
- use warnings;
-
- my $PkgDir = "$ROOTDIR/fontconfig.d";
- my ($Id, $Sb);
-
- sub init {
- $Id ||= defoma_id_open_cache() or return 1;
- $Sb ||= defoma_subst_open(rulename => 'fontconfig',
- threshold => 70,
- idobject => $Id) or return 1;
-
- return 0;
- }
-
- sub register {
- my $font = shift;
- my $hints = parse_hints_start(@_);
-
- return 1 unless $hints->{FontName};
-
- my $priority = $hints->{Priority} || 20;
- my ($fontname) = split / +/, $hints->{FontName};
- my @alias = split / +/, $hints->{Alias} if $hints->{Alias};
-
- defoma_id_register($Id, type => 'real', font => $font,
- id => $fontname, priority => $priority,
- hints => join(' ', @_));
-
- foreach my $alias (@alias) {
- defoma_id_register($Id, type => 'alias', font => $font,
- id => $alias, priority => $priority,
- origin => $fontname);
- }
-
- defoma_subst_register($Sb, $font, $fontname);
-
- return 0;
- }
-
- sub unregister {
- my $font = shift;
- defoma_subst_unregister($Sb, $font);
- defoma_id_unregister($Id, type => 'alias', font => $font);
- defoma_id_unregister($Id, type => 'real', font => $font);
- return 0;
- }
-
- sub do_install_real {
- my $font = shift;
- my $id = shift;
-
- my $dir = $PkgDir . '/' . substr($id, 0, 1);
- my $ext = $font =~ m|\.([^/.]+)$| ? ".$1" : '';
- my $file = $id . $ext;
-
- mkdir $dir;
- symlink $font, "$dir/$file" or return 1;
-
- return 0;
- }
-
- sub do_remove_real {
- my $font = shift;
- my $id = shift;
-
- my $dir = $PkgDir . '/' . substr($id, 0, 1);
- my $ext = $font =~ m|\.([^/.]+)$| ? ".$1" : '';
- my $file = $id . $ext;
-
- unlink "$dir/$file" or return 1;
- rmdir $dir; # ignore failure
-
- return 0;
- }
-
- sub term {
- return unless $Id;
-
- open my $fh, '>', "$PkgDir/fonts.conf" or return 1;
-
- print $fh <<EOF;
- <?xml version="1.0"?>
- <!DOCTYPE fontconfig SYSTEM "/etc/fonts/fonts.dtd">
- <!-- autogenerated by fontconfig.defoma -->
- <fontconfig>
- <dir>$PkgDir</dir>
- EOF
-
- # aliases
- foreach (defoma_id_get_font($Id, installed => type => 'SaI')) {
- print $fh <<EOF
- <alias>
- <family>$Id->{e_id}->[$_]</family>
- <accept><family>$Id->{e_depid}->[$_]</family></accept>
- </alias>
- EOF
- }
-
- # substituded fonts
- foreach (defoma_id_get_font($Id, installed => type => 'SSI')) {
- print $fh <<EOF
- <alias>
- <family>$Id->{e_id}->[$_]</family>
- <default><family>$Id->{e_depid}->[$_]</family></default>
- </alias>
- EOF
- }
-
- print $fh "</fontconfig>\n";
-
- close $fh;
-
- defoma_subst_close($Sb);
- defoma_id_close_cache($Id);
-
- system('fc-cache', $PkgDir);
-
- return 0;
- }
-
- sub main {
- my $cmd = shift;
-
- if ($cmd eq 'init') {
- init();
- } elsif ($cmd eq 'register') {
- return register(@_);
- } elsif ($cmd eq 'unregister') {
- return unregister(@_);
- } elsif ($cmd eq 'do-install-real') {
- return do_install_real(@_);
- } elsif ($cmd eq 'do-remove-real') {
- return do_remove_real(@_);
- } elsif ($cmd eq 'term') {
- return term(@_);
- }
-
- 0;
- }
-
- no warnings;
-
- *truetype = \&main;
- *type1 = \&main;
- *cid = \&main;
-
- 1;
-